unit picture_core;

{$mode objfpc}{$H+}

interface

uses
    Classes, SysUtils, ExtCtrls, Graphics, Math, Dialogs;

const
	GRAPH_UND_M = 30;
	GRAPH_M = 35;
	GRAPH_C = 17;
	GRAPH_X = 5;
	GRAPH_X_STR = -1;
	GRAPH_X_END = 1;
type

    TRPoint = record
    	X: Real;
    	Y: Real;
    end;

    TUndo = record
    	conv_cen: TRPoint;
    	conv_val: TRPoint;
    	conv_com: Integer;
    end;

    TPicture = class
    	private

    		// Область рисования
    		pic_ar: TImage;

    		// Значений графиков функций
    		pic_parab: array [1..GRAPH_M] of TRPoint;
    		pic_exp_n: array [1..GRAPH_M] of TRPoint;
    		pic_exp_r: array [1..GRAPH_M] of TRPoint;

    		// Журнал изменений изображения
    		pic_undo: array [1..GRAPH_UND_M] of TUndo;
    		pic_undo_c: Integer;

    		// Очистка области рисования
    		procedure pic_clear();

    		// Создание записи в журнале изменений
    		procedure conv_undo_add(pic_conv_cen, pic_conv_val: TRPoint; pic_conv_com: Integer);

    	public

    		// Конструктор класса
    		Constructor init(pic_ar_o: TImage);

    		// Преобразования изображения
    		procedure conv_mov(mov_val: TRPoint; use_undo: Boolean = True);
    		procedure conv_scl(scl_cen, scl_val: TRPoint; use_undo: Boolean = True);
    		procedure conv_rot(rot_cen: TRPoint; rot_ang: Real; use_undo: Boolean = True);
    		procedure conv_apply();

    		// Восстановление исходного рисунка
    		procedure conv_restore();

    		// Отмена последнего преобразования
    		function conv_undo() :Boolean;

    		// Получение координат центра области рисования
    		function get_area_cent() :TRPoint;

    		// Получение координат центра изображения
    		function get_pic_cent() :TRPoint;

    end;

implementation

const
	PREC_V = -4;

// Конструктор класса
Constructor TPicture.init(pic_ar_o: TImage);
begin
	// Установка области рисования
	pic_ar := pic_ar_o;
	// Установка начальных параметров рисунка
	conv_restore();
	conv_apply();
end;

///////////////////////////////////////////////////////////////////////////////

// Перенос изображения
procedure conv_mov_apply(var mov_pnt: TRPoint; mov_val: TRPoint);
begin
	with mov_pnt do
	begin
		X := X + mov_val.X;
		Y := Y + mov_val.Y;
	end;
end;

procedure TPicture.conv_mov(mov_val: TRPoint; use_undo: Boolean = True);
var
	I: Integer;
begin

	// Перемещение графиков
	for I := 1 to GRAPH_M do
	begin
		conv_mov_apply(pic_parab[I], mov_val);
		conv_mov_apply(pic_exp_n[I], mov_val);
		conv_mov_apply(pic_exp_r[I], mov_val);
	end;

	// Создание записи в журнале
	if use_undo then conv_undo_add(mov_val, mov_val, 1);

end;

// Масштабирование изображения
procedure conv_scl_apply(var scl_pnt: TRPoint; scl_cen, scl_val: TRPoint);
begin
	with scl_pnt do
	begin
		X := scl_val.X * X + (1 - scl_val.X) * scl_cen.X;
		Y := scl_val.Y * Y + (1 - scl_val.Y) * scl_cen.Y;
	end;
end;

procedure TPicture.conv_scl(scl_cen, scl_val: TRPoint; use_undo: Boolean = True);
var
	I: Integer;
begin

	// Создание записи в журнале
	if use_undo then conv_undo_add(get_pic_cent, scl_val, 2);

	// Масштабирование графиков
	for I := 1 to GRAPH_M do
	begin
		conv_scl_apply(pic_parab[I], scl_cen, scl_val);
		conv_scl_apply(pic_exp_n[I], scl_cen, scl_val);
		conv_scl_apply(pic_exp_r[I], scl_cen, scl_val);
	end;

end;

// Поворот изображения
procedure conv_rot_apply(var rot_pnt: TRPoint; rot_cen: TRPoint; rot_ang: Real);
var
	rot_pnt_bak: TRPoint;
begin
	rot_pnt_bak := rot_pnt;
	with rot_pnt_bak do
	begin
		rot_pnt.X := cos(rot_ang) * (X - rot_cen.X) + sin(rot_ang) * (Y - rot_cen.Y) + rot_cen.X;
		rot_pnt.Y := cos(rot_ang) * (Y - rot_cen.Y) - sin(rot_ang) * (X - rot_cen.X) + rot_cen.Y;
	end;
end;

procedure TPicture.conv_rot(rot_cen: TRPoint; rot_ang: Real; use_undo: Boolean = True);
var
	I: Integer;
	rot_angle: TRPoint;
begin

	// Поворот графиков
	for I := 1 to GRAPH_M do
	begin
		conv_rot_apply(pic_parab[I], rot_cen, rot_ang);
		conv_rot_apply(pic_exp_n[I], rot_cen, rot_ang);
		conv_rot_apply(pic_exp_r[I], rot_cen, rot_ang);
	end;

	// Создание записи в журнале
	with rot_angle do
	begin
		X := rot_ang;
		Y := 0;
	end;

	if use_undo then conv_undo_add(rot_cen, rot_angle, 3);

end;

// Отрисовка текущего изображения
procedure TPicture.conv_apply();
var
	I: Integer;
begin

	// Очистка области рисования
	pic_clear();

	// Отрисовка рисунка
	with pic_ar.Canvas do
	begin

		// Установка цвета линий
		Pen.Color := clBlue;

		// Отрисовка графиков
		for I := 1 to GRAPH_M  - 1 do
		begin
			MoveTo(Round(pic_parab[I].X), Round(pic_parab[I].Y));
			LineTo(Round(pic_parab[I + 1].X), Round(pic_parab[I + 1].Y));
			MoveTo(Round(pic_exp_n[I].X), Round(pic_exp_n[I].Y));
			LineTo(Round(pic_exp_n[I + 1].X), Round(pic_exp_n[I + 1].Y));
			MoveTo(Round(pic_exp_r[I].X), Round(pic_exp_r[I].Y));
			LineTo(Round(pic_exp_r[I + 1].X), Round(pic_exp_r[I + 1].Y));
		end;

		// Отрисовка штриховки
		for I := GRAPH_X + 1 to GRAPH_M - GRAPH_X do
		begin
			MoveTo(Round(pic_parab[I].X), Round(pic_parab[I].Y));
			if I <= GRAPH_C then
				LineTo(Round(pic_exp_n[I].X), Round(pic_exp_n[I].Y))
			else
				LineTo(Round(pic_exp_r[I].X), Round(pic_exp_r[I].Y));
		end;

	end;
end;

// Восстановление исходного рисунка
procedure TPicture.conv_restore();
const
	SCALE_V = 100;
var
	I: Integer;
	pic_crd_tmp: Real;
	pic_crd_stp: Real;
	pic_int_val: TRPoint;
begin

	// Установка начальных значений для параболы
	pic_crd_tmp := GRAPH_X_STR;
	pic_crd_stp := (GRAPH_X_END - GRAPH_X_STR) / (GRAPH_M - 1);

	for I := 1 to GRAPH_M do
	begin
		
		// График параболы
		with pic_parab[I] do
		begin
			X := RoundTo(pic_crd_tmp, PREC_V);
			Y := -RoundTo(pic_crd_tmp * pic_crd_tmp, PREC_V);
		end;

		// График экспоненты
		with pic_exp_n[I] do
		begin
			X := pic_parab[I].X;
			Y := -RoundTo(exp(pic_crd_tmp), PREC_V);
		end;

		// График экспоненты (обратный)
		with pic_exp_r[I] do
		begin
			X := pic_parab[I].X;
			Y := RoundTo(1 / pic_exp_n[I].Y, PREC_V);
		end;

		pic_crd_tmp := pic_crd_tmp + pic_crd_stp;

	end;

	// Перемещение рисунка
	with pic_int_val do
	begin
		X := get_area_cent.X - get_pic_cent.X;
		Y := get_area_cent.Y - get_pic_cent.Y;
	end;
	conv_mov(pic_int_val);

	// Масштабирование рисунка
	with pic_int_val do
	begin
		X := SCALE_V;
		Y := SCALE_V;
	end;
	conv_scl(get_area_cent, pic_int_val);

	// Обнуление журнала изменений
	pic_undo_c := 0;

end;

// Отмена последнего преобразования
function TPicture.conv_undo() :Boolean;
var
	pic_undo_o: TUndo;
begin

	if (pic_undo_c <> 0) then
	begin

		pic_undo_o := pic_undo[pic_undo_c];
		
		case pic_undo_o.conv_com of
			1:
			begin
				with pic_undo_o.conv_val do
				begin
					X := -X;
					Y := -Y;
				end;
				conv_mov(pic_undo_o.conv_val, False);
			end;
			2:
			begin
				with pic_undo_o.conv_val do
				begin
					X := 1 / X;
					Y := 1 / Y;
				end;
				conv_scl(get_pic_cent, pic_undo_o.conv_val, False);
				with pic_undo_o.conv_val do
				begin
					X := pic_undo_o.conv_cen.X - get_pic_cent.X;
					Y := pic_undo_o.conv_cen.Y - get_pic_cent.Y;
				end;
				conv_mov(pic_undo_o.conv_val, False);
			end;
			3:
			begin
				with pic_undo_o.conv_val do
				begin
					X := DegToRad(360) - X;
				end;
				conv_rot(pic_undo_o.conv_cen, pic_undo_o.conv_val.X, False);
			end;
		end;

		conv_apply();
		Dec(pic_undo_c);
		conv_undo := True;

	end
	else
		conv_undo := False;

end;

// Получение координат центра области рисования
function TPicture.get_area_cent() :TRPoint;
var
	pnt_cent: TRPoint;
begin
	with pnt_cent do
	begin
		X := RoundTo(pic_ar.Width / 2, PREC_V);
		Y := RoundTo(pic_ar.Height / 2, PREC_V);
	end;
	get_area_cent := pnt_cent;
end;

// Получение координат центра изображения
function TPicture.get_pic_cent() :TRPoint;
var
	pnt_cent: TRPoint;
begin
	with pnt_cent do
	begin
		X := RoundTo((pic_parab[GRAPH_C].X + 
					  pic_exp_n[GRAPH_C].X) / 2, PREC_V);
		Y := RoundTo((pic_parab[GRAPH_C].Y + 
					  pic_exp_n[GRAPH_C].Y) / 2, PREC_V);
	end;
	get_pic_cent := pnt_cent;
end;

///////////////////////////////////////////////////////////////////////////////

// Очистка области рисования
procedure TPicture.pic_clear();
begin
	with pic_ar.Canvas do
	begin
		Pen.Color := clGray;
		Brush.Color := clWhite;
		Rectangle(0, 0, pic_ar.Width, pic_ar.Height);
	end;
end;

// Создание записи в журнале изменений
procedure TPicture.conv_undo_add(pic_conv_cen, pic_conv_val: TRPoint; pic_conv_com: Integer);
var
	pic_undo_o: TUndo;
begin

	// Проверка переполнения массива
	if (pic_undo_c = GRAPH_UND_M) then
		pic_undo_c := 0;

	// Сборка данных
	with pic_undo_o do
	begin
		conv_cen := pic_conv_cen;
		conv_val := pic_conv_val;
		conv_com := pic_conv_com;	
	end;

	// Внесение изменений
	Inc(pic_undo_c);
	pic_undo[pic_undo_c] := pic_undo_o;

end;

end.

